Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH10/SRC/OBJTRANS.CLS

Text File | 1996-05-04 | 8.3 KB | 292 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjTransformed"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private NumCurvePts As Integer
Private CurvePoints() As Point3D

Private NumTrans As Integer
Private Trans() As Transformation

Private pline As ObjPolyline    ' The display polyline.

' ************************************************
' Add a point to the curve.
' ************************************************
Public Sub AddCurvePoint(x As Single, y As Single, z As Single)
    NumCurvePts = NumCurvePts + 1
    ReDim Preserve CurvePoints(1 To NumCurvePts)
    CurvePoints(NumCurvePts).coord(1) = x
    CurvePoints(NumCurvePts).coord(2) = y
    CurvePoints(NumCurvePts).coord(3) = z
    CurvePoints(NumCurvePts).coord(4) = 1
End Sub


' ************************************************
' Set a transformation.
' ************************************************
Public Sub SetTrans(M() As Single)
    NumTrans = NumTrans + 1
    ReDim Preserve Trans(1 To NumTrans)
    m3MatCopy Trans(NumTrans).M, M
End Sub

' ************************************************
' Create the display polyline by applying the
' series of transformations in array M().
' ************************************************
Public Sub Transform()
Dim i As Integer
Dim j As Integer
Dim x0 As Single
Dim y0 As Single
Dim z0 As Single
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim x2 As Single
Dim y2 As Single
Dim z2 As Single

    Set pline = New ObjPolyline

    ' Add the original curve to pline.
    x1 = CurvePoints(1).coord(1)
    y1 = CurvePoints(1).coord(2)
    z1 = CurvePoints(1).coord(3)
    For j = 2 To NumCurvePts
        x2 = CurvePoints(j).coord(1)
        y2 = CurvePoints(j).coord(2)
        z2 = CurvePoints(j).coord(3)
        pline.AddSegment x1, y1, z1, x2, y2, z2
        x1 = x2
        y1 = y2
        z1 = z2
    Next j

    ' Start with the transformed coordinates
    ' the same as the original coordinates.
    For j = 1 To NumCurvePts
        CurvePoints(j).Trans(1) = CurvePoints(j).coord(1)
        CurvePoints(j).Trans(2) = CurvePoints(j).coord(2)
        CurvePoints(j).Trans(3) = CurvePoints(j).coord(3)
    Next j

    ' Create the transformed copies of the curve.
    For i = 1 To NumTrans
        ' Place the first point.
        x1 = CurvePoints(1).Trans(1)
        y1 = CurvePoints(1).Trans(2)
        z1 = CurvePoints(1).Trans(3)
        m3ApplyFull _
            CurvePoints(1).coord, Trans(i).M, _
            CurvePoints(1).Trans
        x0 = CurvePoints(1).Trans(1)
        y0 = CurvePoints(1).Trans(2)
        z0 = CurvePoints(1).Trans(3)
        pline.AddSegment x1, y1, z1, x0, y0, z0

        ' Add the rest of the points.
        For j = 2 To NumCurvePts
            x1 = CurvePoints(j).Trans(1)
            y1 = CurvePoints(j).Trans(2)
            z1 = CurvePoints(j).Trans(3)
            m3ApplyFull _
                CurvePoints(j).coord, Trans(i).M, _
                CurvePoints(j).Trans
            x2 = CurvePoints(j).Trans(1)
            y2 = CurvePoints(j).Trans(2)
            z2 = CurvePoints(j).Trans(3)
            ' (x0, y0, z0) = previous point, new.
            ' (x1, y1, z1) = current point, old.
            ' (x2, y2, z2) = current point, new.
            pline.AddSegment x0, y0, z0, x2, y2, z2
            pline.AddSegment x1, y1, z1, x2, y2, z2
            x0 = x2
            y0 = y2
            z0 = z2
        Next j
    Next i
End Sub

' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "TRANSFORMED"
End Property



' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer

    ' Fix the curve points.
    For i = 1 To NumCurvePts
        For j = 1 To 3
            CurvePoints(i).coord(j) = CurvePoints(i).Trans(j)
        Next j
    Next i

    ' Fix the display polyline if it exists.
    If Not pline Is Nothing Then pline.FixPoints
End Sub

' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer

    ' Transform the curve.
    For i = 1 To NumCurvePts
        m3ApplyFull CurvePoints(i).coord, M, _
                    CurvePoints(i).Trans
    Next i

    ' Transform the display polyline if it exists.
    If Not pline Is Nothing Then pline.ApplyFull M
End Sub

' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer

    ' Transform the curve.
    For i = 1 To NumCurvePts
        m3Apply CurvePoints(i).coord, M, _
                CurvePoints(i).Trans
    Next i

    ' Transform the display polyline if it exists.
    If Not pline Is Nothing Then pline.Apply M
End Sub


' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer

    ' Distort the curve.
    For i = 1 To NumCurvePts
        D.Distort CurvePoints(i).coord(1), _
                  CurvePoints(i).coord(2), _
                  CurvePoints(i).coord(3)
    Next i

    ' Distort the display polyline if it exists.
    If Not pline Is Nothing Then pline.Distort D
End Sub


' ************************************************
' Write the surface's display polyline object to a
' file using Write. The data can later be loaded
' into an ObjPolyline object but not an
' ObjRotated object.
' ************************************************
Public Sub FileWritePolyline(filenum As Integer)
    If Not pline Is Nothing Then pline.FileWrite filenum
End Sub


' ************************************************
' Write an extruded surface to a file using Write.
' Begin with "TRANSFORMED" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer

    ' Write basic information.
    Write #filenum, "TRANSFORMED", NumCurvePts, _
        NumTrans

    ' Write the curve points.
    For i = 1 To NumCurvePts
        Write #filenum, _
            CurvePoints(i).coord(1), _
            CurvePoints(i).coord(2), _
            CurvePoints(i).coord(3)
    Next i

    ' Write the transformations.
    For i = 1 To NumTrans
        For j = 1 To 4
            For k = 1 To 4
                Write #filenum, Trans(i).M(j, k)
            Next k
        Next j
    Next i
End Sub




' ************************************************
' Draw the extrusion on a Form, Printer, or
' PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional R As Variant)
    If Not pline Is Nothing Then _
        pline.Draw canvas, R
End Sub


' ************************************************
' Read a grid from a file using Input.
' Assume the "TRANSFORMED" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer

    ' Get the basic information.
    Input #filenum, NumCurvePts, NumTrans

    ' Allocate and read the curve array.
    ReDim CurvePoints(1 To NumCurvePts)
    For i = 1 To NumCurvePts
        Input #filenum, _
            CurvePoints(i).coord(1), _
            CurvePoints(i).coord(2), _
            CurvePoints(i).coord(3)
        CurvePoints(i).coord(4) = 1
    Next i

    ' Allocate and read the transformations.
    ReDim Trans(1 To NumTrans)
    For i = 1 To NumTrans
        For j = 1 To 4
            For k = 1 To 4
                Input #filenum, Trans(i).M(j, k)
            Next k
        Next j
    Next i

    ' Create the display polyline.
    Transform
End Sub